#light

module CGraph.Generic.Algorithms
open System.Xml
open CGraph.Generic


/// Given a method that takes an object of type
/// 'A' and returns option<A>, call method on its results
/// until it returns none.
let rec RecursiveIterate iter initial =
    match (iter initial) with
        | Some moreItems -> RecursiveIterate iter moreItems
        | None -> ()
        
        
let CommaDelimit names =
    let mutable first = true
    let builder = new System.Text.StringBuilder()
    for (name:string) in names do
        if (not first) then builder.Append(",") |> ignore
        builder.Append name |> ignore
    builder.ToString()
    
let FindUniqueGeneric name existingNames newNameMeth =
    let mutable name = name
    let exists name =
        let existing = 
            existingNames 
            |> Seq.first( fun( existingName ) -> if existingName = name then Some existingName else None )
        match existing with
            | Some exists -> true
            | None -> false
    while exists name do
        name <- newNameMeth()
    name
    
/// Find an unique str out of the collection of existing names    
let FindUniqueStr name existingNames =
    let stem = name
    let idx = ref 0
    let generator = 
        fun()->
            let current = !idx
            idx := !idx + 1
            stem + current.ToString()
    FindUniqueGeneric name existingNames generator
    
/// Find a unique path but don't change the file ending.
let FindUniquePathStr stem ending existingNames =
    let name = stem + ending
    let idx = ref 0
    let generator = 
        fun()->
            let current = !idx
            idx := !idx + 1
            stem + current.ToString() + ending
    FindUniqueGeneric name existingNames generator
    

let FilterTyped filter input =
    input
    |> Seq.filter( 
        fun(arg)->
            match filter arg with
                | Some arg -> true
                | None -> false )
    |> Seq.map( 
        fun(arg)->
            match filter arg with
                | Some arg -> arg
                | None -> raise (System.InvalidOperationException( "Filter should have taken care of this" ) ) )
    

let XmlNodeChildren (node:XmlNode) = 
        node.ChildNodes 
        |> Seq.map_to_typed( fun( (item:obj) ) -> item :?> XmlNode )
        |> Seq.filter( fun(child) -> child :? XmlElement )
        |> Seq.map( fun(child) -> child :?> XmlElement )
        
        
let XmlNodeText (node:XmlNode) = 
    node.ChildNodes 
    |> Seq.map_to_typed( fun( (item:obj) ) -> item :?> XmlNode )
    |> Seq.filter( fun(child) -> child :? XmlText )
    |> Seq.map( fun(child) -> child :?> XmlText )
    
let XmlNodeValue (node:XmlNode) =
    match node with
        | :? XmlAttribute as att -> att.Value
        | _ ->
            let builder = System.Text.StringBuilder()
            for text in XmlNodeText node do
                builder.Append text.Value |> ignore
            builder.ToString()
        
        
let XmlNodeAtts (node:XmlNode) = 
        node.Attributes 
        |> Seq.map_to_typed( fun( (item:obj) ) -> item :?> XmlAttribute )
    
    
type XSDIdStr =
    | XSDDoc of string
    | XSDId of string
    | XSDDocId of string*string
    
//Parse the URI to figure out where it is going.
//document URI's are in the form of:  doc#id I believe
//../Material/Unit Tests/MaterialReplacement/FxComposer2FixedFunctionConstant.dae#Scene
//So there are several test cases where this is very important to get correct.
//You may have blah.dae to reference a document, or just blah to reference an object.
//A forward slash guarantees a document, text in front of the first # guarantees a
//document, etc.    
//The result may be a document, a document,id, or an id.
let ParseXSDId (idStr:string) =
    let parts = idStr.Split([|'#'|])
    match parts.Length with
        | 2 -> 
            match parts.[0].Length with
                | 0 -> XSDId(parts.[1])
                | _ -> XSDDocId(parts.[0],parts.[1])
        | 1 ->
            //This is the tricky part.
            let first = idStr.IndexOfAny( [|'/';'.'|] )
            match first with
                | -1 -> XSDId(parts.[0])
                | _ -> XSDDoc(parts.[0])
        | _ -> invalid_arg ("Null or invalid string passed in")
            
//Helper functions to map to and from handles as well as sequences of handles.
let ToHandle (value:'a) (hdl:int) = Handle<'a>(hdl)
let ToHandleSeq (value:'a seq) (hdlMap:obj->int) = value |> Seq.map (fun arg -> ToHandle arg (hdlMap (arg :> obj)))
let FromHandle (hdl:Handle<'a>) (objMap:int->obj) = (objMap hdl.Handle) :?> 'a
let FromHandleSeq (hdls:Handle<'a> seq) (objMap:int->obj) = hdls |> Seq.map (fun arg -> FromHandle arg objMap)


type ObjectHandleSystem( m_objmap:ObjectCollection, m_handleIndex:ObjectCollectionHandleIndex
    , m_objectIndex:ObjectCollectionObjectIndex, m_inc:IncrementFunc<int>
    , m_refCollection:HandleRefCollection, m_refIndex:HandleRefHandleIndex ) =
        member s.ObjectMap = m_objmap
        member s.HandleIndex = m_handleIndex
        member s.ObjectIndex = m_objectIndex
        member s.Incrementor = m_inc
        member system.GetOrCreateObjHandle value = 
            let success,existing = system.ObjectIndex.Items.TryGetValue value
            match success with
                | true -> existing.Handle
                | false -> 
                    let newHandle = system.Incrementor()
                    system.StoreObject newHandle value
                    newHandle
                    
        member system.GetHandleObj value = 
            let success,existing = system.HandleIndex.Items.TryGetValue value
            match success with
                | true -> existing.Object
                | false -> failwith "Schema Graph Data Handle Not Found"
                
        member s.ToHandle value = ToHandle value (s.GetOrCreateObjHandle (value :> obj))
        member s.FromHandle hdl = FromHandle hdl s.GetHandleObj
        member s.FromHandleSeq values = values |> Seq.map(fun item -> (s.FromHandle item))
        member s.ToHandleSeq values = values |> Seq.map(fun item -> (s.ToHandle item))    
        member s.StoreObject newHandle value =
                    let newEntry = { Handle=newHandle; Object=value }
                    s.ObjectMap.Add newEntry
        member s.RemoveObject hdl = 
            let success,existing = s.HandleIndex.Items.TryGetValue hdl
            if success then m_objmap.Remove existing |> ignore
            let success,ref = m_refIndex.Items.TryGetValue hdl
            if success then m_refCollection.Remove ref |> ignore
            
        member s.AddReference hdl =
            let success,ref = m_refIndex.Items.TryGetValue hdl
            let ref = 
                if (not success) 
                    then
                        let (newRef:HandleRef) = { Handle=hdl; RefCount=0 }
                        m_refCollection.Add newRef
                        newRef
                    else
                        ref
            ref.RefCount <- ref.RefCount + 1
            
        member s.RemoveReference hdl (final_check:int->bool) = 
            let success,ref = m_refIndex.Items.TryGetValue hdl
            if success 
                then 
                    ref.RefCount <- ref.RefCount - 1
                    if ref.RefCount <= 0
                        then
                            if ( final_check hdl ) then s.RemoveObject hdl
            
            
            
    
let CreateObjectHandleSystem (incFunc:IncrementFunc<int>) =
    let collection = MultiCollection<ObjectEntry>()
    let handleIndex = ObjectCollectionHandleIndex()
    let objectIndex = ObjectCollectionObjectIndex()
    collection.AddSubCollection handleIndex
    collection.AddSubCollection objectIndex
    let incrementor = fun() ->
            let mutable next = incFunc()
            while handleIndex.Items.ContainsKey next do
                next <- incFunc()
            next
    let refCollection = MultiCollection<HandleRef>()
    let refIndex = HandleRefHandleIndex()
    refCollection.AddSubCollection refIndex
    ObjectHandleSystem( collection, handleIndex, objectIndex, incFunc, refCollection, refIndex )
        
        
let CreateIncFunc() =
    let current = ref 0;
    let incFunc() = 
        current := !current + 1
        !current
    incFunc